home *** CD-ROM | disk | FTP | other *** search
/ One Click 21 / ONCK021.iso / Exemplos Macros / Visual Documents / VDM.CAB / TextPrintingModule.bas < prev    next >
Encoding:
BASIC Source File  |  2003-07-11  |  3.8 KB  |  150 lines

  1. Attribute VB_Name = "TextPrintingModule"
  2. Global TextArray() As String
  3.  
  4. Function LoadText(ByVal FNAME As String) As String
  5. On Error GoTo FNL
  6.     Dim FNUM As Integer
  7.     FNUM = FreeFile
  8.     Open FNAME For Input As #FNUM
  9.         LoadText = Input(LOF(FNUM), FNUM)
  10.     Close #FNUM
  11.     Exit Function
  12. FNL:
  13.     LoadText = "File could not be loaded!"
  14.     Close #FNUM
  15.     Exit Function
  16. End Function
  17.  
  18. Function GetMaxChar(ByVal PIC, ByVal FNT As String, ByVal Sz As Single) As Integer
  19.     Dim h As String
  20.     PIC.FontName = Trim$(FNT)
  21.     PIC.FontSize = Sz
  22.     h = ""
  23.     While PIC.Width > PIC.TextWidth(h)
  24.         h = h + "H"
  25.     Wend
  26.     GetMaxChar = Len(h) - 1
  27. End Function
  28.  
  29. Sub TextJustify(ByVal PIC, ByVal TXT As String, ByVal FNTName As String, ByVal FNTSize, ByVal FNTColor As Long)
  30. On Error GoTo PFAIL
  31.     
  32.     TXT = Replace(TXT, vbCrLf + vbCrLf, "%%")
  33.     TXT = Replace(TXT, vbCrLf, "")
  34.     TXT = Replace(TXT, "%%", vbCrLf)
  35.     
  36.     'GET MAX CHARACTERS PER ROW
  37.     RW = GetMaxChar(PIC, FNTName, FNTSize)
  38.     
  39.     If Trim$(Alg) = "" Then Alg = "J"
  40.  
  41.     PIC.CurrentX = 567
  42.     PIC.CurrentY = 0
  43.  
  44.     'CALCULATE SPACE NEED IT FOR EACH CHARACTER
  45.     SC = PIC.Width \ RW
  46.     
  47.     'STEP TROUGH THE TEXT
  48.     For L = 1 To Len(TXT) Step RW
  49.         TX = Mid$(TXT, L, RW)
  50.  
  51.         xC = InStr(TX, vbCrLf)
  52.         xL = Len(TX) - xC
  53.         
  54.         ' CHECK IF THER IS A CARRIAGE RETURN TO CHANGE THE ROW
  55.         If InStr(TX, vbCrLf) > 0 Then
  56.             INTERLINE = 75
  57.             L = L - xL
  58.             TX = Left(TX, xC)
  59.         Else
  60.             INTERLINE = 25
  61.             If InStr(TX, " ") > 0 Then
  62.                 CAR = Right$(TX, 1)
  63.                 While CAR <> " "
  64.                     CAR = Right$(TX, 1)
  65.                     If CAR <> " " Then
  66.                         TX = Left$(TX, Len(TX) - 1)
  67.                         L = L - 1
  68.                     End If
  69.                 Wend
  70.             End If
  71.             If InStr(TX, " ") > 0 Then TX = JustifiedAligned(RW, TX)
  72.         End If
  73.         
  74.         TX = Trim$(TX)
  75.         
  76.         ' SET FONT SIZE
  77.         PIC.FontSize = FNTSize
  78.         PIC.FontName = FNTName
  79.         PIC.ForeColor = FNTColor
  80.         PIC.FontItalic = False
  81.         ' CALCULATE INITIAL ROW POSITION
  82.         CY = PIC.CurrentY + INTERLINE
  83.         'IF TEXT IS OUT OF THE PICTURE BOX THEN SKIP IT TO SPEED UP THE PROCESS
  84.         If CY > PIC.Height Then Exit For
  85.  
  86.         'READ EACH LETTER IN THE SENTENCE IN ORDER TO CALCULATE ITS POSITION
  87.         For CH = 1 To Len(TX)
  88.             ' GET THE LETTER
  89.             U = Mid$(TX, CH, 1)
  90.             ' SET HORIZONTAL POSITION
  91.             PIC.CurrentX = (CH - 1) * SC
  92.             ' SET ROW POSITION
  93.             PIC.CurrentY = CY
  94.             ' PRINT THE LETTER
  95.             PIC.Print U
  96.         Next CH
  97.     Next L
  98.  
  99.     Exit Sub
  100. PFAIL:
  101.     Exit Sub
  102. End Sub
  103.  
  104. Function JustifiedAligned(ByVal RW As Integer, ByVal S As String) As String
  105. On Error Resume Next
  106.     S = Trim$(S)
  107.     
  108.     If Len(S) >= RW Then
  109.         JustifiedAligned = S
  110.         Exit Function
  111.     End If
  112.     
  113.     If InStr(S, " ") = 0 Then
  114.         JustifiedAligned = S
  115.         Exit Function
  116.     End If
  117.     
  118.     DX = Abs(Len(S) - RW)
  119.     
  120.     CH = ""
  121.     TMP = ""
  122.     CT = 0
  123.     
  124.     For I = 1 To Len(S)
  125.         CH = Mid$(S, I, 1)
  126.         If CH = " " Then
  127.             CH = "  "
  128.             CT = CT + 1
  129.         End If
  130.         TMP = TMP + CH
  131.         If CT >= (DX - 1) Then
  132.             TMP = TMP + Mid$(S, I, Len(S))
  133.             Exit For
  134.         End If
  135.     Next I
  136.  
  137.     If Len(TMP) < RW Then
  138.         TXT = JustifiedAligned(RW, TMP)
  139.     Else
  140.         TXT = TMP
  141.     End If
  142.     
  143.     If Left$(TXT, 1) = Mid$(TXT, 2, 1) Then TXT = Mid$(TXT, 2, Len(TXT) - 1)
  144.     If Right$(TXT, 1) = Mid$(TXT, Len(TXT) - 1, 1) Then TXT = Left$(TXT, Len(TXT) - 1)
  145.       
  146.     JustifiedAligned = Trim$(TXT)
  147.     
  148. End Function
  149.  
  150.